home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / dptools / mousedtv.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-08  |  21.4 KB  |  862 lines
  1. {
  2.   programme de changement de curseur sous turbo vision
  3.    programme realise par
  4.     charles vidal
  5.     pour toutes suggestions
  6.     email : vidal@amertume.ufr-info-p7.ibp.fr
  7.  
  8.  }
  9. program Edit_curseur_TV;
  10. uses Dos, Crt,MsgBox, Objects, Drivers,Views,Menus, Dialogs,
  11.      App,InpLong,stddlg,tvgraph;
  12.  
  13. const
  14.   cmAbout = 1000;
  15.   cmLoad = 1001;
  16.   cmsave = 1002;
  17.   cmModifier = 1003;
  18.   cmInverse = 1004;
  19.   cmFill =1005;
  20.   cmClear=1006;
  21.   cmessai = 1010;
  22.   cmmodif_masque=1011;
  23.   cmfillmasque=1012;
  24.   cmrotation=1014;
  25.   cmpascal=1015;
  26.   cmsourceC=1016;
  27.   cmmodif_xy=1017;
  28. type
  29.   TListboxRec = record
  30.     PS : PStringCollection;
  31.     Focused : Integer;
  32.     end;
  33. type
  34.   TMyApp = object(TApplication)
  35.     procedure InitMenuBar; virtual;
  36.     procedure LoadCurseur;
  37.     procedure saveascurseur;
  38.     procedure Modif_curseur;
  39.     procedure Inverse_curseur;
  40.     procedure Fill_curseur;
  41.     procedure Fill_masque;
  42.     procedure clear_curseur;
  43.     procedure essai_curseur;
  44.     procedure modif_ecran;
  45.     procedure rotation90;
  46.     procedure pascal;
  47.     procedure sourcec;
  48.     procedure modif_xy;
  49.     procedure HandleEvent(var Event: TEvent); virtual;
  50.   end;
  51. Type
  52.   dessin_curseur = record
  53.                      contx,conty    : integer;
  54.                      mask_ecran   : array[0..15] of word;
  55.                      mask_curseur : array[0..15] of word;
  56.                    end;
  57.  
  58. Const
  59.   fleche: dessin_curseur = (contx:0; conty:0;
  60.                             mask_ecran:   ($3FFF,$1FFF,$0FFF,$07FF,
  61.                                              $03FF,$01FF,$00FF,$007F,
  62.                                              $003F,$001F,$01FF,$10FF,
  63.                                              $30FF,$F87F,$F87F,$FC3F);
  64.                             mask_curseur: ($0000,$4000,$6000,$7000,
  65.                                              $7800,$7C00,$7E00,$7F00,
  66.                                              $7F80,$7FC0,$7C00,$4600,
  67.                                              $0600,$0300,$0300,$0000));
  68.  
  69. var modif_c: dessin_curseur;
  70. var
  71.      fichier:file of dessin_curseur;
  72.      fichiert:Text;
  73.      char:array[1..16] of byte;
  74. var
  75.   DataRecChar : record
  76.     Field1 : Word;
  77.     Field2 : Word;
  78.     Field3 : Word;
  79.     Field4 : Word;
  80.     Field5 : Word;
  81.     Field6 : Word;
  82.     Field7 : Word;
  83.     Field8 : Word;
  84.     Field9 : Word;
  85.     Field10 : Word;
  86.     Field11 : Word;
  87.     Field12 : Word;
  88.     Field13 : Word;
  89.     Field14 : Word;
  90.     Field15 : Word;
  91.     Field16 : Word;
  92.   end;
  93.  
  94. var
  95.   MyApp: TMyApp;
  96.   i:byte;
  97.   chaine:string;
  98.  
  99. {-----------------function misc .----------------------}
  100. Procedure change_souris(var p:dessin_curseur);
  101. Var reg : registers;
  102. begin
  103.     with reg,p do
  104.     begin
  105.       ax:=9;
  106.       bx:=contx;
  107.       cx:=conty;
  108.       dx:=ofs(mask_ecran[00]);
  109.       es:=seg(mask_ecran[00]);
  110.     end;
  111.     intr($33,reg);
  112. end;
  113.  
  114. function bit_a_un(a,pos:word):Boolean;
  115. BEGIN
  116.  if ((a shr pos) and 1)=1 then bit_a_un:=true
  117.     else bit_a_un:=false;
  118. END;
  119. procedure put_bit_a_un(var a:word;pos:word);
  120. BEGIN
  121.  a:=a or (1 shl pos);
  122. END;
  123. procedure rotation(var source,dest:dessin_curseur);
  124. var i,j:byte;
  125. BEGIN
  126.  fillchar(dest,sizeof(dessin_curseur),0);
  127.  for i:=0 to 15 do
  128.  BEGIN
  129.   for j:=0 to 15 do
  130.    BEGIN
  131.    if bit_a_un(source.mask_curseur[i],j) then put_bit_a_un(dest.mask_curseur[j],15-i);
  132.    if bit_a_un(source.mask_ecran[i],j) then put_bit_a_un(dest.mask_ecran[j],15-i);
  133.    END;
  134.   END;
  135. END;
  136. { ------------------ les boites dialogues --------------------- }
  137. function nom : PDialog;
  138. var
  139.   Dlg : PDialog;
  140.   R : TRect;
  141.   Control : PView;
  142.  
  143. begin
  144. R.Assign(24, 2, 58, 9);
  145. New(Dlg, Init(R,'Nom du curseur'));
  146. Dlg^.Flags := Dlg^.Flags and not wfClose;
  147.  
  148. R.Assign(4, 2, 21, 3);
  149. Control := New(PInputLine, Init(R, 13));
  150. Dlg^.Insert(Control);
  151.  
  152. R.Assign(1, 4, 13, 6);
  153. Control := New(PButton, Init(R, '~O~K', cmOK, bfDefault));
  154. Dlg^.Insert(Control);
  155.  
  156. R.Assign(13, 4, 25, 6);
  157. Control := New(PButton, Init(R, '~A~nnuler', cmCancel, bfgrabfocus));
  158. Dlg^.Insert(Control);
  159.  
  160. Dlg^.SelectNext(False);
  161. nom := Dlg;
  162. end;
  163.  
  164. function xydialog : PDialog;
  165. var
  166.   Dlg : PDialog;
  167.   R : TRect;
  168.   Control : PView;
  169.  
  170. begin
  171. R.Assign(10, 2, 45, 9);
  172. New(Dlg, Init(R, 'x y dialogue'));
  173. Dlg^.Palette := dpBlueDialog;
  174.  
  175. R.Assign(8, 2, 16, 3);
  176. Control := New(PInputLong, Init(R, 6, 0, 15, 0));
  177. Dlg^.Insert(Control);
  178.  
  179.   R.Assign(2, 2, 5, 3);
  180.   Dlg^.Insert(New(PLabel, Init(R, 'X', Control)));
  181.  
  182. R.Assign(8, 4, 16, 5);
  183. Control := New(PInputLong, Init(R, 6, 0, 15, 0));
  184. Dlg^.Insert(Control);
  185.  
  186.   R.Assign(2, 4, 5, 5);
  187.   Dlg^.Insert(New(PLabel, Init(R, 'Y', Control)));
  188.  
  189. R.Assign(22, 2, 32, 4);
  190. Control := New(PButton, Init(R, 'O~k~', cmOK, bfDefault));
  191. Dlg^.Insert(Control);
  192.  
  193. R.Assign(22, 4, 32, 6);
  194. Control := New(PButton, Init(R, 'C~a~ncel', cmCancel, bfGrabFocus));
  195. Dlg^.Insert(Control);
  196.  
  197. Dlg^.SelectNext(False);
  198. xydialog := Dlg;
  199. end;
  200.  
  201. function MakeDialogC(titre:string) : PDialog;
  202. var
  203.   Dlg : PDialog;
  204.   R : TRect;
  205.   Control : PView;
  206.  
  207. begin
  208. R.Assign(3, 2, 71, 24);
  209. New(Dlg, Init(R, titre));
  210.  
  211. R.Assign(1, 1, 5, 17);
  212. Control := New(PCheckboxes, Init(R,
  213.   NewSItem('A',  NewSItem('b',  NewSItem('c ',  NewSItem('d',
  214.   NewSItem('e',
  215.   NewSItem('f',
  216.   NewSItem('i',
  217.   NewSItem('j',
  218.   NewSItem('k',
  219.   NewSItem('l',
  220.   NewSItem('o',
  221.   NewSItem('p',
  222.   NewSItem('k',
  223.   NewSItem('q',
  224.   NewSItem('x',
  225.   NewSItem('x',
  226.   Nil))))))))))))))))));
  227. Dlg^.Insert(Control);
  228.  
  229. R.Assign(5, 1, 10, 17);
  230. Control := New(PCheckboxes, Init(R,
  231.   NewSItem('a',
  232.   NewSItem('a',
  233.   NewSItem('a',
  234.   NewSItem('a',
  235.   NewSItem('a',
  236.   NewSItem('a',
  237.   NewSItem('a',
  238.   NewSItem('a',
  239.   NewSItem('a',
  240.   NewSItem('a',
  241.   NewSItem('a',
  242.   NewSItem('a',
  243.   NewSItem('a',
  244.   NewSItem('a',
  245.   NewSItem('a',
  246.   NewSItem('x',
  247.    Nil))))))))))))))))));
  248. Dlg^.Insert(Control);
  249.  
  250. R.Assign(9, 1, 14, 17);
  251. Control := New(PCheckboxes, Init(R,
  252.   NewSItem('b',
  253.   NewSItem('b',
  254.   NewSItem('b',
  255.   NewSItem('b',
  256.   NewSItem('b',
  257.   NewSItem('b',
  258.   NewSItem('b',
  259.   NewSItem('b',
  260.   NewSItem('b',
  261.   NewSItem('b',
  262.   NewSItem('b',
  263.   NewSItem('b',
  264.   NewSItem('b',
  265.   NewSItem('b',
  266.   NewSItem('b',
  267.   NewSItem('x',
  268.   Nil))))))))))))))))));
  269. Dlg^.Insert(Control);
  270.  
  271. R.Assign(13, 1, 18, 17);
  272. Control := New(PCheckboxes, Init(R,
  273.   NewSItem('c',
  274.   NewSItem('c',
  275.   NewSItem('c',
  276.   NewSItem('c',
  277.   NewSItem('c',
  278.   NewSItem('c',
  279.   NewSItem('c',
  280.   NewSItem('c',
  281.   NewSItem('c',
  282.   NewSItem('c',
  283.   NewSItem('c',
  284.   NewSItem('c',
  285.   NewSItem('c',
  286.   NewSItem('c',
  287.   NewSItem('c',
  288.   NewSItem('x',
  289.   Nil))))))))))))))))));
  290. Dlg^.Insert(Control);
  291.  
  292. R.Assign(17, 1, 22, 17);
  293. Control := New(PCheckboxes, Init(R,
  294.   NewSItem('d',
  295.   NewSItem('d',
  296.   NewSItem('d',
  297.   NewSItem('d',
  298.   NewSItem('d',
  299.   NewSItem('d',
  300.   NewSItem('d',
  301.   NewSItem('d',
  302.   NewSItem('d',
  303.   NewSItem('d',
  304.   NewSItem('d',
  305.   NewSItem('d',
  306.   NewSItem('d',
  307.   NewSItem('d',
  308.   NewSItem('d',
  309.   NewSItem('x',
  310.   Nil))))))))))))))))));
  311. Dlg^.Insert(Control);
  312.  
  313. R.Assign(21, 1, 26, 17);
  314. Control := New(PCheckboxes, Init(R,
  315.   NewSItem('e',
  316.   NewSItem('e',
  317.   NewSItem('e',
  318.   NewSItem('e',
  319.   NewSItem('e',
  320.   NewSItem('e',
  321.   NewSItem('e',
  322.   NewSItem('e',
  323.   NewSItem('e',
  324.   NewSItem('e',
  325.   NewSItem('e',
  326.   NewSItem('e',
  327.   NewSItem('e',
  328.   NewSItem('e',
  329.   NewSItem('e',
  330.   NewSItem('x',
  331.   Nil))))))))))))))))));
  332. Dlg^.Insert(Control);
  333.  
  334. R.Assign(25, 1, 30, 17);
  335. Control := New(PCheckboxes, Init(R,
  336.   NewSItem('f',
  337.   NewSItem('f',
  338.   NewSItem('f',
  339.   NewSItem('f',
  340.   NewSItem('f',
  341.   NewSItem('f',
  342.   NewSItem('f',
  343.   NewSItem('f',
  344.   NewSItem('f',
  345.   NewSItem('f',
  346.   NewSItem('f',
  347.   NewSItem('f',
  348.   NewSItem('f',
  349.   NewSItem('f',
  350.   NewSItem('f',
  351.   NewSItem('x',
  352.   Nil))))))))))))))))));
  353. Dlg^.Insert(Control);
  354.  
  355. R.Assign(29, 1, 34, 17);
  356. Control := New(PCheckboxes, Init(R,
  357.   NewSItem('g',
  358.   NewSItem('g',
  359.   NewSItem('g',
  360.   NewSItem('g',
  361.   NewSItem('g',
  362.   NewSItem('g',
  363.   NewSItem('g',
  364.   NewSItem('g',
  365.   NewSItem('g',
  366.   NewSItem('g',
  367.   NewSItem('g',
  368.   NewSItem('g',
  369.   NewSItem('g',
  370.   NewSItem('g',
  371.   NewSItem('g',
  372.   NewSItem('x',
  373.   Nil))))))))))))))))));
  374. Dlg^.Insert(Control);
  375.  
  376. R.Assign(33, 1, 38, 17);
  377. Control := New(PCheckboxes, Init(R,
  378.   NewSItem('A',  NewSItem('b',  NewSItem('c ',  NewSItem('d',
  379.   NewSItem('e',
  380.   NewSItem('f',
  381.   NewSItem('i',
  382.   NewSItem('j',
  383.   NewSItem('k',
  384.   NewSItem('l',
  385.   NewSItem('o',
  386.   NewSItem('p',
  387.   NewSItem('k',
  388.   NewSItem('q',
  389.   NewSItem('x',
  390.   NewSItem('x',
  391.   Nil))))))))))))))))));
  392. Dlg^.Insert(Control);
  393.  
  394. R.Assign(37, 1, 42, 17);
  395. Control := New(PCheckboxes, Init(R,
  396.   NewSItem('a',
  397.   NewSItem('a',
  398.   NewSItem('a',
  399.   NewSItem('a',
  400.   NewSItem('a',
  401.   NewSItem('a',
  402.   NewSItem('a',
  403.   NewSItem('a',
  404.   NewSItem('a',
  405.   NewSItem('a',
  406.   NewSItem('a',
  407.   NewSItem('a',
  408.   NewSItem('a',
  409.   NewSItem('a',
  410.   NewSItem('a',
  411.   NewSItem('x',
  412.   Nil))))))))))))))))));
  413. Dlg^.Insert(Control);
  414.  
  415. R.Assign(41, 1, 46, 17);
  416. Control := New(PCheckboxes, Init(R,
  417.   NewSItem('b',
  418.   NewSItem('b',
  419.   NewSItem('b',
  420.   NewSItem('b',
  421.   NewSItem('b',
  422.   NewSItem('b',
  423.   NewSItem('b',
  424.   NewSItem('b',
  425.   NewSItem('b',
  426.   NewSItem('b',
  427.   NewSItem('b',
  428.   NewSItem('b',
  429.   NewSItem('b',
  430.   NewSItem('b',
  431.   NewSItem('b',
  432.   NewSItem('x',
  433.   Nil))))))))))))))))));
  434. Dlg^.Insert(Control);
  435.  
  436. R.Assign(45, 1, 50, 17);
  437. Control := New(PCheckboxes, Init(R,
  438.   NewSItem('c',
  439.   NewSItem('c',
  440.   NewSItem('c',
  441.   NewSItem('c',
  442.   NewSItem('c',
  443.   NewSItem('c',
  444.   NewSItem('c',
  445.   NewSItem('c',
  446.   NewSItem('c',
  447.   NewSItem('c',
  448.   NewSItem('c',
  449.   NewSItem('c',
  450.   NewSItem('c',
  451.   NewSItem('c',
  452.   NewSItem('c',
  453.   NewSItem('x',
  454.   Nil))))))))))))))))));
  455. Dlg^.Insert(Control);
  456.  
  457. R.Assign(49, 1, 54, 17);
  458. Control := New(PCheckboxes, Init(R,
  459.   NewSItem('d',
  460.   NewSItem('d',
  461.   NewSItem('d',
  462.   NewSItem('d',
  463.   NewSItem('d',
  464.   NewSItem('d',
  465.   NewSItem('d',
  466.   NewSItem('d',
  467.   NewSItem('d',
  468.   NewSItem('d',
  469.   NewSItem('d',
  470.   NewSItem('d',
  471.   NewSItem('d',
  472.   NewSItem('d',
  473.   NewSItem('d',
  474.   NewSItem('x',
  475.   Nil))))))))))))))))));
  476. Dlg^.Insert(Control);
  477.  
  478. R.Assign(53, 1, 58, 17);
  479. Control := New(PCheckboxes, Init(R,
  480.   NewSItem('e',
  481.   NewSItem('e',
  482.   NewSItem('e',
  483.   NewSItem('e',
  484.   NewSItem('e',
  485.   NewSItem('e',
  486.   NewSItem('e',
  487.   NewSItem('e',
  488.   NewSItem('e',
  489.   NewSItem('e',
  490.   NewSItem('e',
  491.   NewSItem('e',
  492.   NewSItem('e',
  493.   NewSItem('e',
  494.   NewSItem('e',
  495.   NewSItem('x',
  496.   Nil))))))))))))))))));
  497. Dlg^.Insert(Control);
  498.  
  499. R.Assign(57, 1, 62, 17);
  500. Control := New(PCheckboxes, Init(R,
  501.   NewSItem('f',
  502.   NewSItem('f',
  503.   NewSItem('f',
  504.   NewSItem('f',
  505.   NewSItem('f',
  506.   NewSItem('f',
  507.   NewSItem('f',
  508.   NewSItem('f',
  509.   NewSItem('f',
  510.   NewSItem('f',
  511.   NewSItem('f',
  512.   NewSItem('f',
  513.   NewSItem('f',
  514.   NewSItem('f',
  515.   NewSItem('f',
  516.   NewSItem('x',
  517.   Nil))))))))))))))))));
  518. Dlg^.Insert(Control);
  519.  
  520. R.Assign(61, 1, 66, 17);
  521. Control := New(PCheckboxes, Init(R,
  522.   NewSItem('g',
  523.   NewSItem('g',
  524.   NewSItem('g',
  525.   NewSItem('g',
  526.   NewSItem('g',
  527.   NewSItem('g',
  528.   NewSItem('g',
  529.   NewSItem('g',
  530.   NewSItem('g',
  531.   NewSItem('g',
  532.   NewSItem('g',
  533.   NewSItem('g',
  534.   NewSItem('g',
  535.   NewSItem('g',
  536.   NewSItem('g',
  537.   NewSItem('x',
  538.   Nil))))))))))))))))));
  539. Dlg^.Insert(Control);
  540.  
  541. R.Assign(3, 18, 13, 20);
  542. Control := New(PButton, Init(R, 'O~k~', cmOK, bfDefault));
  543. Dlg^.Insert(Control);
  544.  
  545. R.Assign(29, 18, 39, 20);
  546. Control := New(PButton, Init(R, 'C~a~ncel', cmCancel, bfGrabfocus));
  547. Dlg^.Insert(Control);
  548.  
  549. Dlg^.SelectNext(False);
  550. MakeDialogc:= Dlg;
  551. end;
  552. {---------------------------------------}
  553. procedure TMyApp.essai_curseur;
  554. var curseur_tempo:dessin_curseur;
  555. begin
  556. rotation(modif_c,curseur_tempo);
  557. change_souris(curseur_tempo);
  558. messagebox('   Alors Qu''en dites vous ?',nil,mfokbutton);
  559. change_souris(fleche);
  560. end;
  561. procedure TMyApp.Loadcurseur;
  562. var
  563.   R: TRect;
  564.   FileDialog: PFileDialog;
  565.   TheFile: FNameStr;
  566.   b:byte;
  567. const
  568.   FDOptions: Word = fdOKButton or fdOpenButton;
  569. begin
  570.   TheFile := '*.CUR';
  571.   New(FileDialog, Init(TheFile, 'Open file', '~F~ile name',
  572.     FDOptions, 1));
  573.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  574.   begin
  575.    assign(Fichier,TheFile);
  576.    reset(Fichier);
  577.    read(Fichier,modif_c);
  578.    close(fichier);
  579.   end;
  580. end;
  581. procedure TMyApp.saveascurseur;
  582. var
  583.   R: TRect;
  584.   FileDialog: PFileDialog;
  585.   TheFile: FNameStr;
  586. const
  587.   FDOptions: Word = fdOKButton or fdOpenButton;
  588. begin
  589.   TheFile := '*.CUR';
  590.   New(FileDialog, Init(TheFile, 'Save file', '~F~ile name',
  591.     FDOptions, 1));
  592.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  593.   begin
  594.    assign(Fichier,TheFile);
  595.    rewrite(Fichier);
  596.    write(Fichier,modif_c);
  597.    close(fichier);
  598.   end;
  599. end;
  600.  
  601. procedure TMyApp.Modif_curseur;
  602. var j:byte;
  603.     k:word;
  604.     b:byte;
  605.     tempo:string;
  606. begin
  607.   with Datarecchar,modif_c do
  608.    begin
  609.     field1:=mask_curseur[0];field2:=mask_curseur[1];field3:=mask_curseur[2];
  610.     field4:=mask_curseur[3];field5:=mask_curseur[4];field6:=mask_curseur[5];
  611.     field7:=mask_curseur[6];field8:=mask_curseur[7];
  612.     field9:=mask_curseur[8];field10:=mask_curseur[9];field11:=mask_curseur[10];
  613.     field12:=mask_curseur[11];field13:=mask_curseur[12];field14:=mask_curseur[13];field15:=mask_curseur[14];
  614.     field16:=mask_curseur[15];
  615.     end;
  616.   if Application^.ExecuteDialog(MakeDialogC('Figure'),@Datarecchar) = cmOk then
  617.   begin
  618.     with Datarecchar,modif_c do
  619.      begin
  620.      mask_curseur[0]:=field1;mask_curseur[1]:=field2;mask_curseur[2]:=field3;
  621.     mask_curseur[3]:=field4;mask_curseur[4]:=field5;mask_curseur[5]:=field6;
  622.     mask_curseur[6]:=field7;mask_curseur[7]:=field8;
  623.     mask_curseur[8]:=field9;mask_curseur[9]:=field10;mask_curseur[10]:=field11;
  624.     mask_curseur[11]:=field12;mask_curseur[12]:=field13;mask_curseur[13]:=field14;
  625.     mask_curseur[14]:=field15;mask_curseur[15]:=field16;
  626.      end;
  627.  end;
  628. end;
  629. procedure TMyApp.Modif_ecran;
  630. var j:byte;
  631.     k:word;
  632.     b:byte;
  633.     tempo:string;
  634. begin
  635.   with Datarecchar,modif_c do
  636.    begin
  637.     field1:=mask_ecran[0];field2:=mask_ecran[1];field3:=mask_ecran[2];
  638.     field4:=mask_ecran[3];field5:=mask_ecran[4];field6:=mask_ecran[5];
  639.     field7:=mask_ecran[6];field8:=mask_ecran[7];
  640.     field9:=mask_ecran[8];field10:=mask_ecran[9];field11:=mask_ecran[10];
  641.     field12:=mask_ecran[11];field13:=mask_ecran[12];field14:=mask_ecran[13];field15:=mask_ecran[14];
  642.     field16:=mask_ecran[15];
  643.     end;
  644.   if Application^.ExecuteDialog(MakeDialogC('Masque'),@Datarecchar) = cmOk then
  645.   begin
  646.     with Datarecchar,modif_c do
  647.      begin
  648.      mask_ecran[0]:=field1;mask_ecran[1]:=field2;mask_ecran[2]:=field3;
  649.     mask_ecran[3]:=field4;mask_ecran[4]:=field5;mask_ecran[5]:=field6;
  650.     mask_ecran[6]:=field7;mask_ecran[7]:=field8;
  651.     mask_ecran[8]:=field9;mask_ecran[9]:=field10;mask_ecran[10]:=field11;
  652.     mask_ecran[11]:=field12;mask_ecran[12]:=field13;mask_ecran[13]:=field14;
  653.     mask_ecran[14]:=field15;mask_ecran[15]:=field16;
  654.      end;
  655.  end;
  656. end;
  657. procedure TMyApp.Rotation90;
  658. var tempo_curseur:dessin_curseur;
  659. BEGIN
  660.  rotation(modif_c,tempo_curseur);
  661.  modif_c:=tempo_curseur;
  662. END;
  663. procedure TMyApp.pascal;
  664. var t_c:dessin_curseur;
  665. R: TRect;
  666.   FileDialog: PFileDialog;
  667.   TheFile: FNameStr;
  668. var nomcurseur :record
  669.     F1: string[30];
  670.   end;
  671. const
  672.   FDOptions: Word = fdOKButton or fdOpenButton;
  673. begin
  674.   rotation(modif_c,t_c);
  675.   fillchar(nomcurseur,sizeof(nomcurseur),0);
  676.   if ExecuteDialog(nom, @nomcurseur) <> cmCancel then
  677.   BEGIN
  678.   TheFile := '*.PAS';
  679.   New(FileDialog, Init(TheFile, 'Save file', '~F~ile name',
  680.     FDOptions, 1));
  681.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  682.   begin
  683.    assign(fichiert,theFile);
  684.    {$I-}
  685.    append(fichiert);
  686.    {$I+}
  687.    if IOResult<>0 then rewrite(fichiert);
  688.    with t_c do
  689.    begin
  690.    writeln(fichiert,'const ',nomcurseur.f1,': dessin_curseur = (contx:',contx,'; conty:',conty,';');
  691.    writeln(fichiert,' mask_ecran:   (',mask_ecran[0],',',mask_ecran[1],',',mask_ecran[2],',',mask_ecran[3],',');
  692.    writeln(fichiert,'               ',mask_ecran[4],',',mask_ecran[5],',',mask_ecran[6],',',mask_ecran[7],',');
  693.    writeln(fichiert,'               ',mask_ecran[8],',',mask_ecran[9],',',mask_ecran[10],',',mask_ecran[11],',');
  694.    writeln(fichiert,'               ',mask_ecran[12],',',mask_ecran[13],',',mask_ecran[14],',',mask_ecran[15],');');
  695.    writeln(fichiert,' mask_curseur:   (',mask_curseur[0],',',mask_curseur[1],',',mask_curseur[2],',',mask_curseur[3],',');
  696.    writeln(fichiert,'               ',mask_curseur[4],',',mask_curseur[5],',',mask_curseur[6],',',mask_curseur[7],',');
  697.    writeln(fichiert,'               ',mask_curseur[8],',',mask_curseur[9],',',mask_curseur[10],',',mask_curseur[11],',');
  698.    writeln(fichiert,'     ',mask_curseur[12],',',mask_curseur[13],',',mask_curseur[14],',',mask_curseur[15],'));');
  699.    end;
  700.    close(fichiert);
  701.   end;
  702.  end;
  703. END;
  704. procedure TMyApp.sourceC;
  705. var t_c:dessin_curseur;
  706. R: TRect;
  707.   FileDialog: PFileDialog;
  708.   TheFile: FNameStr;
  709. var nomcurseur :record
  710.     F1: string[13];
  711.   end;
  712. const
  713.   FDOptions: Word = fdOKButton or fdOpenButton;
  714. begin
  715.   rotation(modif_c,t_c);
  716.   if ExecuteDialog(nom, @nomcurseur) <> cmCancel then
  717.   BEGIN
  718.   TheFile := '*.C';
  719.   New(FileDialog, Init(TheFile, 'Save file', '~F~ile name',
  720.     FDOptions, 1));
  721.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  722.   begin
  723.    assign(fichiert,theFile);
  724.    {$I-}
  725.    append(fichiert);
  726.    {$I+}
  727.    if IOResult<>0 then rewrite(fichiert);
  728.   with t_c do
  729.    begin
  730.    writeln(fichiert,'const dessin_curseur ',nomcurseur.f1,' = {{',contx,',',conty,'},');
  731.    writeln(fichiert,' {',mask_ecran[0],',',mask_ecran[1],',',mask_ecran[2],',',mask_ecran[3],',');
  732.    writeln(fichiert,'  ',mask_ecran[4],',',mask_ecran[5],',',mask_ecran[6],',',mask_ecran[7],',');
  733.    writeln(fichiert,'  ',mask_ecran[8],',',mask_ecran[9],',',mask_ecran[10],',',mask_ecran[11],',');
  734.    writeln(fichiert,'  ',mask_ecran[12],',',mask_ecran[13],',',mask_ecran[14],',',mask_ecran[15],'},');
  735.    writeln(fichiert,' {',mask_curseur[0],',',mask_curseur[1],',',mask_curseur[2],',',mask_curseur[3],',');
  736.    writeln(fichiert,'  ',mask_curseur[4],',',mask_curseur[5],',',mask_curseur[6],',',mask_curseur[7],',');
  737.    writeln(fichiert,'  ',mask_curseur[8],',',mask_curseur[9],',',mask_curseur[10],',',mask_curseur[11],',');
  738.    writeln(fichiert,'  ',mask_curseur[12],',',mask_curseur[13],',',mask_curseur[14],',',mask_curseur[15],'}};');
  739.    end;
  740.    close(fichiert);
  741.   end;
  742.  end;
  743. END;
  744.  
  745. procedure TMyApp.Inverse_curseur;
  746. var j:byte;
  747. begin
  748.   for j:=0 to 15 do
  749.   modif_c.mask_ecran[j]:=
  750.           modif_c.mask_curseur[j] xor 65535;
  751. end;
  752.  
  753. procedure TMyApp.Clear_curseur;
  754. var j:byte;
  755. begin
  756.   for j:=0 to 15 do
  757.   modif_c.mask_curseur[j]:=0;
  758. end;
  759. procedure TMyApp.Fill_curseur;
  760. var j:byte;
  761. begin
  762.   for j:=0 to 15 do
  763.   modif_c.mask_curseur[j]:=65535;
  764. end;
  765.  
  766. procedure TMyApp.Fill_masque;
  767. var j:byte;
  768. begin
  769.   for j:=0 to 15 do
  770.   modif_c.mask_ecran[j]:=65535;
  771. end;
  772. procedure TMyApp.Modif_xy;
  773. var
  774.   xyrec : record
  775.     X : LongInt;
  776.     Y : LongInt;
  777.   end;
  778. begin
  779.  xyrec.X:=modif_c.contx;
  780.  xyrec.Y:=modif_c.conty;
  781.  if ExecuteDialog(xydialog, @xyrec) <> cmCancel then
  782.   if (xyrec.X<16) and (xyrec.X<16) then begin
  783.                                          modif_c.contx:=xyrec.X;
  784.                                          modif_c.conty:=xyrec.y;
  785.                                         end
  786.      else messagebox('erreur x<16 y<16 ',nil,mferror);
  787. end;
  788. procedure TMyApp.HandleEvent(var Event: TEvent);
  789. begin
  790. TApplication.HandleEvent(Event);
  791. case Event.What of
  792.     evCommand:
  793.       case Event.Command of
  794.        cmabout:
  795.         messagebox('         Curseur Edit                charles vidal 1994      vidal@amertume.ufr-info-p7.ibp.fr'
  796.             ,nil,mfinformation);
  797.        cmModifier:Modif_curseur;
  798.        cmsave:saveascurseur;
  799.        cmload:loadcurseur;
  800.        cmInverse:Inverse_curseur;
  801.        cmFill:Fill_curseur;
  802.        cmClear:Clear_curseur;
  803.        cmessai:essai_curseur;
  804.        cmmodif_masque:modif_ecran;
  805.        cmfillmasque:fill_masque;
  806.        cmrotation:rotation90;
  807.        cmpascal:pascal;
  808.        cmsourcec:sourcec;
  809.        cmmodif_xy:modif_xy;
  810.       end;
  811.     end;
  812. ClearEvent(Event);
  813. end;
  814.  
  815. Procedure TMyApp.InitMenuBar;
  816. var
  817.   R : TRect;
  818.  
  819. begin
  820.   GetExtent(R);
  821.   R.B.Y := R.A.Y + 1;
  822.  
  823.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  824.     NewSubMenu('#',hcNoContext,
  825.     NewMenu(
  826.       NewItem('About', '', kbNoKey, cmAbout, hcNoContext,
  827.       nil)),
  828.     NewSubMenu('~F~ile',hcNoContext,
  829.     NewMenu(
  830.       NewItem('Load', '', kbNoKey, cmLoad, hcNoContext,
  831.       NewItem('save', '', kbNoKey, cmsave, hcNoContext,
  832.       NewItem('Source Pascal','',kbNoKey, cmpascal, hcNoContext,
  833.       NewItem('Source C','',kbNoKey, cmsourcec, hcNoContext,
  834.       NewItem('~Q~uitter', '', kbNoKey, cmQuit, hcNoContext,
  835.       nil)))))),
  836.     NewSubMenu('~M~odifier',hcNoContext,
  837.     NewMenu(
  838.       NewItem('Figure', '', kbNoKey, cmModifier, hcNoContext,
  839.       NewItem('Masque', '', kbNoKey, cmmodif_masque, hcNoContext,
  840.       NewItem('Modif X Y', '', kbNoKey, cmmodif_xy, hcNoContext,
  841.      nil)))),
  842.     {NewItem('~M~odifier', '', kbNoKey, cmModifier, hcNoContext,}
  843.     NewSubMenu('~E~ffect',hcNoContext,
  844.     NewMenu(
  845.       NewItem('Creer masque (Inverse figure)', '', kbNoKey, cmInverse, hcNoContext,
  846.       NewItem('Fill figure', '', kbNoKey, cmFill, hcNoContext,
  847.       NewItem('Fill masque', '', kbNoKey, cmFillmasque, hcNoContext,
  848.       NewItem('Clear', '', kbNoKey, cmClear, hcNoContext,
  849.       NewItem('Rotation', '', kbNoKey, cmrotation, hcNoContext,
  850.       NewItem('Essai', '', kbNoKey, cmEssai, hcNoContext,
  851.     nil))))))),
  852.      NewItem('E~s~sai', '', kbNoKey, cmEssai, hcNoContext,
  853.     nil))))))
  854.   ));
  855. end;
  856.  
  857. begin
  858.   MyApp.Init;
  859.   MyApp.Run;
  860.   MyApp.Done;
  861. end.
  862.